home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / fastcwd.pl < prev    next >
Text File  |  2008-07-24  |  1KB  |  44 lines
  1. # By John Bazik
  2. #
  3. # This library is no longer being maintained, and is included for backward
  4. # compatibility with Perl 4 programs which may require it.
  5. #
  6. # In particular, this should not be used as an example of modern Perl
  7. # programming techniques.
  8. #
  9. # Suggested alternative: Cwd
  10. #
  11. # Usage: $cwd = &fastcwd;
  12. #
  13. # This is a faster version of getcwd.  It's also more dangerous because
  14. # you might chdir out of a directory that you can't chdir back into.
  15.  
  16. sub fastcwd {
  17.     local($odev, $oino, $cdev, $cino, $tdev, $tino);
  18.     local(@path, $path);
  19.     local(*DIR);
  20.  
  21.     ($cdev, $cino) = stat('.');
  22.     for (;;) {
  23.         ($odev, $oino) = ($cdev, $cino);
  24.         chdir('..');
  25.         ($cdev, $cino) = stat('.');
  26.         last if $odev == $cdev && $oino == $cino;
  27.         opendir(DIR, '.');
  28.         for (;;) {
  29.             $_ = readdir(DIR);
  30.             next if $_ eq '.';
  31.             next if $_ eq '..';
  32.  
  33.             last unless $_;
  34.             ($tdev, $tino) = lstat($_);
  35.             last unless $tdev != $odev || $tino != $oino;
  36.         }
  37.         closedir(DIR);
  38.         unshift(@path, $_);
  39.     }
  40.     chdir($path = '/' . join('/', @path));
  41.     $path;
  42. }
  43. 1;
  44.